Sort. mesa 2-Sep-78 18:18:51 Page 



--file Sort. mesa 

--last modified by Bruce on July 30, 1978 4:30 PM 

-- translated from Ed McCreight's BCPL by Jim Frandeen 

DIRECTORY 

AltoDefs: FROM "AltoDefs", 

FSPDefs: FROM "fspdefs" USING [NoRoomlnZone, NodeOverhead] , 

GPsortDefs: FROM "GPsortDef s" , 

InlineDefs: FROM "inlinedefs" USING [COPY], 

StreamDefs: FROM "StreamDefs"; 

DEFINITIONS FROM GPsortDefs; 

Sort: PROGRAM 

IMPORTS FSPDefs, GPsortDefs, StreamDefs 

EXPORTS GPsortDefs - 
BEGIN 

NFiles: CARDINAL = 3; -- number of scratch files 

bufferSize: INTEGER; 

compareProc: CompareProcType; 

files: ARRAY [0. .NFiles] OF FdHandle; 

f irstFreeEnt: CARDINAL; -- 1 + end of unsorted part of heap vector 

getProc: GetProcType; 

heap: DESCRIPTOR FOR ARRAY OF ItemHeaderHandle; 

heapSize: CARDINAL; -- end of heap-sorted part of heap vector 

inputFinished: BOOLEAN; 

itemlsLeftOver: BOOLEAN; 

lef toverl tern: ItemHandle; 

lef toverl temLen: ItemLength; 

level : CARDINAL; 

maxHeapSize: CARDINAL; 

maxItemWords: CARDINAL; 

ocdtemWords: CARDINAL; 

putProc: PutProcType; 

recordSize: CARDINAL; 

RecordTooLong: PUBLIC ERROR ■ CODE; 

BuildHeap: PROCEDURE - 
BEGIN 

L: CARDINAL; 
heapSize ♦- 0; 
MaintainHeap[]; 
heapSize <~ f irstFreeEnt-1; 
L <- (heapSize/2)+l; 
WHILE L > 1 DO 

L «- L-l; 

SiftDown[L,heap[L]]; 

ENDLOOP; 
RETURN; 
END; 

BuildRuns: PROCEDURE = 
BEGIN 

--Continue reading and sorting, alternating in Fibonacci sequence, until the input is exhausted. 
A: CARDINAL; 
item: ItemHeaderHandle; 
i: CARDINAL; 
j: CARDINAL 4- 1; 
LFile: FdHandle; 
NT: CARDINAL; 
level <- 1; 
DO OPEN f iles[j]; 

IF level > 1 THEN dh . put[dh , EOR] ; -- end-of-run marker 
FOR item <- GetHeap[], GetHeap[] UNTIL item ■ NIL DO 
dh . put[dh , item. Ten] ; 

[] <- StreamDef s .WriteBlock[dh, @item. rec, item. len]; 

ocdtemWords «- occItemWords-item. len -SIZE [ItemLength]- FSPDefs .NodeOverhead; 
Free[i tern]; 
ENDLOOP; 
dummyRuns <~ dummyRuns-1; 

IF inputFinished AND (f irstFreeEnt - 1) THEN EXIT; 
IF dummyRuns < files[j+l] .dummyRuns THEN 
j - j + 1 
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ELSE 
BEGIN 

j «- i; 

IF dummyRuns a THEN 
BEGIN 

level +- level+1; 
A <- files[l], totalRuns; 
FOR i IN[l..NFiles-l] 
DO 

LFile <- files[i]; 
NT <- A+fi 1es[i+l]. totalRuns; 
LFile. dummyRuns <- 
NT - LFile. totalRuns; 
LFile. totalRuns «- NT; 
ENDLOOP; 
END; 
END; 
BuildHeap[]; 
ENDLOOP; 
FOR i IN [1. .NFiles-1] DO OPEN files[i]; 
dh.put[dh, EOR]; 
dh. reset[dh]; 
ENDLOOP; 

RETURN; 
END; 

FreeAllocatedStuff: PROCEDURE » 
BEGIN 

i: CARDINAL; 
FOR i IN[1. .NFiles] DO 

IF files[i]. buffer # NIL THEN Free[f iles[i] . buffer]; 

IF files[i]. record tt NIL THEN Free[files[i] . record] ; 

Free[f iles[i]] ; 

ENDLOOP; 
IF BASE[heap] # NIL THEN Free[BASE[heap]] ; 
IF leftoverltem § NIL THEN Freepef toverltem] ; 
EraseHeap[]; 
RETURN; 
END; 

GetHeap: PROCEDURE RETURNS[itemHP: ItemHeaderHandle] « 
BEGIN 

IF heapSize ■ THEN RETURN[NIL]; 
MaintainHeap[] ; 
itemHP *~ heap[l]; 
SiftDown[l .heap [heapSize]]; 
firstFreeEnt <- f irstFreeEnt-1; 
heap[heapSize] *- heap[f irstFreeEnt] ; 
heapSize <- heapSize~l; 
RETURN; 
END; 

Initialize: PROCEDURE [res, expected, max: CARDINAL] » 
BEGIN 

blockSize: INTEGER; 
heapPages.i: CARDINAL; 

res <- res + 92; -- 82 for mesa(include bitmap), 10 for me 
heapPages ♦- Al toDef s.MaxVMPage - MAX[res , 128] ; 
blockSize <- heapPages * Al toDef s .PageSize; 
In itHeap[ heap Pages] ; 
FOR i IN[1. .NFiles] DO 

files[i] <- Alloc[SIZE[Fd]]; 

files[i]» buffer ♦- NIL; 

f iles[i] . record *- NIL; 

ENDLOOP; 
bufferSize <- (blockSize)/NFiles - 100; 

recordSize <- IF bufferSize > LOOPHOLE[max, INTEGER] THEN max ELSE bufferSize; 
maxlleapSize «- (blockSize-recordSize)/(expected+3) ; -- this 3 is magic 
maxItemWords ♦- blockSize-maxHeapSize-recordSize; 
occItemWords <- 0; 
RETURN; 
END; 

Maintainlleap: PROCEDURE » 
BEGIN 
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-- Fill the heap as full as possible 
itemHP: ItemHeaderHandle; 
IF inputFinished THEN RETURN; 
WHILE firstFreeEnt <» maxHeapSize DO 
-- Try adding another heap element 
IF NOT itemlsLeftOver THEN 
BEGIN 

lef toverltemLen <- getProc[leftoverItem]; 
IF LOOPHOLE[leftoverItemLen,CARDINAL] > recordSize THEN 

ERROR RecordTooLong; 
IF leftoverltemLen « THEN 
BEGIN 

inputFinished <- TRUE; 
EXIT; 
END; 
END; 
IF occItemWords > a maxItemWords THEN 
BEGIN 

itemlsLeftOver <- TRUE; 
EXIT; 
END; 
itemHP <- Al loc[lef toverItemLen+SIZE[ItemLength] IFSPDef s .NoRoomlnZone ■> 
BEGIN 

maxItemWords <- occItemWords - 100; 
itemlsLeftOver <- TRUE; 
--GOTO done; 
END]; 
occItemWords «- 

ocdtemWords+lef toverItemLen+SIZE[ItemLength]+FSPDef s .NodeOverhead; 
itemHP. Ten <~ leftoverltemLen; 

In! ineDef s . COPY[lef tover I tern, lef toverltemLen , @ itemHP. rec]; 
heap[f irstFreeEnt] «- heap[heapSize+l] ; 
firstFreeEnt <~ f irstFreeEnt+1; 
heap[heapSize+l] <- itemHP; 
itemlsLeftOver *- FALSE; 

IF heapSize > AND compareProc[@itemHP. rec,@heap[l]. rec] = GT THEN 
BEGIN 

heapSize <- heapSize+1; 
SiftUp[]; 
END; 
ENDLOOP; 
RETURN; 
END; 

MergePass: PROCEDURE = 
BEGIN 

dummiesThisPass: CARDINAL; 
lastFile: FdHandle; 
OFile: FdHandle; 
runNo: CARDINAL; 
runsThisPass: CARDINAL; 

OFile <- f iles[NFiles]; 
lastFile <- f iles[NFiles-l]; 

runsThisPass <- 1 astFile . totalRuns; 
dummiesThisPass <- 1 astFile. dummyRuns ; 

— FOR i IN[1. .NFiles-2] 

dummiesThisPass <- MIN[dummiesThisPass ,files[l] .dummyRuns]; 

OFile. totalRuns *- runsThisPass; 
OFile. dummyRuns <- dummiesThisPass; 

-- FOR i IN[1. .NFiles-2] 

files[l]. totalRuns +- f iles[l] . totalRuns-runsThisPass; 

files[l] . dummyRuns <- f iles[l] . dummyRuns-dummiesThisPass; 

FOR runNo IN[dummiesThisPass+l .. runsThisPass] DO 

MergeRun[OFile]; 

ENDLOOP; 
IF level > 1 THEN 

BEGIN fd: FdHandle; i: CARDINAL; 

riushBuffer[OFi1e]; 

FOR i IN [NFiles-1, .NFiles] DO OPEN files[i]; 
dh. reset[dh]; 
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head «- 0; 

tail <- 0; 

ENDLOOP; 
fd <- f1les[NFiles]; 
FOR i DECREASING IN (l..NF1les] DO 

fi1es[i] «- files[i-l]; 

ENDLOOP; 
files[l] ♦• fd; 
END; 
RETURN; 
END; 

MergeRun: PROCEDURE[OFile: FdHandle] ■ 
BEGIN 

-- Process a run. Fill up the applicable records, 
i: CARDINAL; 
SR: CARDINAL; 

FOR i IN[l..NFiles-l] DO OPEN files[i]; 
IF dummyRuns = THEN 

[] *• ReadRecord[files[i]] 
ELSE 

BEGIN 

dummyRuns <- dummyRuns-1; 

endOfRun <- TRUE; 

END; 
ENDLOOP; 

DO 

SR «- 0; -- selected record (which file is it from) 

FOR i IN[1. .NFiles-1] DO OPEN files[i]; 

IF (NOT endOfRun) AND (SR ■ OR compareProc[ 

record, files[SR] . record] - LT) THEN SR <- i; 
ENDLOOP; 

IF SR = THEN EXIT; -- come back and fix this 

IF level = 1 THEN putProc[f iles[SR] . record ,fi les[SR] . 1 en] 

ELSE WriteRecord[OFile,files[SR]. len.fi les[SR]. record]; 

files[SR] . record <- NIL; -- for cleanup guy 

[] <- ReadRecord[f iles[SR]]; 

ENDLOOP; 
IF level > 1 THEN WriteRecord[OFile , -1, NIL]; — - end-of-run marker 
RETURN; 
END; 

ReadRecord: PROCEDURE[f ile: FdHandle] RETURNS[BOOLEAN] - 
BEGIN 

itemLen: ItemLength; 
headlndex: INTEGER; 

IF file. head=LOOPHOLE[file. tail, CARDINAL] THEN Fil !Buffer[f ile , buff erSize] ; 
headlndex <- file. head; 
itemLen ♦- f ile .buf fert[headlndex] ; 
file. head «- headlndex *- headlndex+l; 
IF itemLen < THEN 

BEGIN 

file. endOfRun <- TRUE; 

RETURN[FALSE]; 

END; 
IF headlndex+itemLen > file. tail THEN FillBuf f er[f ile, bufferSize]; 
headlndex <- file. head; 
file. record <- 0f il e.buf fert[headlndex] ; 
file. head <- headlndex+itemLen; 
file.len «- itemLen; 
file. endOfRun «- FALSE; 
RETURN[TRUE]; 
END; 

SiftDown: PROCEDURE[L: CARDINAL, K: ItemHeaderHandle] - 
BEGIN 

J: CARDINAL <- L; 
I: CARDINAL; 

DO 

I <- J; 

J <- J+J; 

IF J > heapS ize THEN EXIT; 

IF J < heapSize THEN 

IF compareProc[@heap[J],rec,@heap[J+l].rec] > THEN J *- J+l; 
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IF compareProc[@K.rec,@heap[J].rec] <■ THEN EXIT; 

heap[I] «- heap[J]; 

ENDLOOP; 
heap[I] <- K; 
RETURN; 
END; 

SiftUp: PROCEDURE ■ 
BEGIN 

i: CARDINAL; 
j: CARDINAL *- heapSize; 
k: ItemHeaderHandle <• heap[heapSize] ; 
i *- j/2; 
WHILE 1 > DO 

IF compareProc[@heap[i].rec,@k.rec] <■ THEN EXIT; 

heap[j] <- heap[i]; 

j <" i; 

i «- j/2; 

ENDLOOP; 
heap[j] «- k; 
RETURN; 
END; 

WriteRecord: PROCEDURE [file: FdHandle, itemLen: ItemLength, 
itemPtr: ItemHandle] ■ 
BEGIN 

buffer: ItemHandle <- file. buffer; 
taillndex: INTEGER <- file. tail; 
IF tai!Index+(IF itemLen < THEN 1 ELSE itemLen+1) > bufferSize THEN 

BEGIN 

FlushBuffer[file]; 

taillndex <- file, tail ; 

END; 
buffert[tail Index] «- itemLen; 
taillndex «- taillndex+l; 
IF itemLen >= THEN 

BEGIN 

InlineDefs.COPY[itemPtr, itemLen, @buf fert[ tail Index] ]; 

taillndex <- taillndex+itemLen; 

END; 
file. tail <- taillndex; 
RETURN; s 
END; 

Sort: PUBLIC PROCEDURE [get: GetProcType, put: PutProcType, 

compare: CompareProcType, expectedltemSize: CARDINAL, maxItemSize: CARDINAL, 

reservedPages: CARDINAL] ■ 

BEGIN 

DefaultExpected: CARDINAL * 10; — words 

DefaultMax: CARDINAL - 1000; 

DefaultReserved: CARDINAL ■ 10; 

item: ItemHeaderHandle; 

fid: STRING - "SORT.SCRATCH0" ; 

i: CARDINAL; 

lastChar: CARDINAL ♦- f id. length-1; 

Initial ize[IF reservedPages # THEN reservedPages ELSE DefaultReserved, 
IF expectedltemSize # THEN expectedltemSize ELSE DefaultExpected, 
IF maxItemSize # THEN maxItemSize ELSE DefaultMax]; 

getProc <- get; 

compareProc <- compare; 

putProc <- put; 

heap «- DESCRIPTOR[Alloc[maxHeapSize+l],maxHeapSize+l]; 

firstFreeEnt <- 1; 

-- First, fill up the heap as much as possible and sort it. 

leftoverltem <- Alloc[recordSize]; 

itemlsLeftOver «- FALSE; 

inputFinished <- FALSE; 

BuildHeap[]; 

IF inputFinished THEN 
THROUGH [1.. heapSize] DO 

item +- GetHeap[]; 

put[@i tern. rec, item. len]; 

ENDLOOP 
ELSE 
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BEGIN 

FOR i IN[l..NFiles-l] DO OPEN StreamDef s, files[i]; 

fid[lastChar] «- f id[lastChar]+l; 

dh «- NewWordStream[f id, Append+Write+Read] ; 

totalRuns «- 1; 

dummyRuns <- 1; 

ENDLOOP; 
files[NFiles], totalRuns ♦- 0; 
files[NFi les] .dummyRuns «- 0; 
BuildRuns[]; 

-- Put runs on input files l..NFiles-l so that they have Fibonacci relationship 
Free[lef t over I tern] ; 
leftoverltem <- NIL; 
Free[BASE[heap]]; 
heap «- DESCRIPTOR[NIL,0]; 
IF level > 1 THEN 

BEGIN OPEN StreamDefs; 

fid[lastChar] <- f id[lastChar]+l; 

f iles[NFiles].dh <- NewWordStream[f id , Append+Write+Read] ; 

END; 
FOR i IN[l..NFiles] DO OPEN files[i]; 

buffer <- Alloc[bufferSize]; 

head <- 0; 

tail <- 0; 

ENDLOOP; 
-- Now carry out merge passes until the level has returned to zero. 
UNTIL level - DO 

MergePass[]; 

-- also cycles the files afterward if levelM 

level *- level-1; 

IF level = 1 THEN DeleteFil e[f iles[NFiles] . dh] ; — Output will go to the putltemParam routine 

ENDLOOP; 
FOR i IN [1. .NFiles-1] DO 

DeleteFile[files[i].dh]; 

ENDLOOP; 
END; 
FreeAllocatedStuff[]; 
RETURN; 
END; 

END... 



